Datenanalyse in R II

Jannis Bosch

Setup + kurze Wiederholung

Setup

  • Bitte erstellt wieder ein R Projekt und öffnet es

  • Erstellt ein R-Skript für den heutigen Workshop

Daten herunterladen

Hier klicken um den Datensatz runterzuladen

Daten einlesen & Bibliotheken laden

# Lest zunächst den Datensatz ein
mydata <- readRDS(file.path("dateien", "experiment_data.rds"))

library(tidyverse)
library(psych)

Wiederholung - Skalen bilden

Items für die Skalen definieren

# Im Datensatz sind Items aus acht verschiedenen Skalen
# Erstellt nun zunächst für jede Skala einen Vektor mit den Item-Namen im Datensatz
sc1_items <- c("sc1_1", "sc1_2_rev", "sc1_3", "sc1_4_rev") # self-concept (pre-test)
sc2_items <- c("sc2_1", "sc2_2_rev", "sc2_3", "sc2_4_rev") # self-concept (post-test)
int1_items <- c("int1_1", "int1_2", "int1_3", "int1_4") # interest (pre-test)
int2_items <- c("int2_1", "int2_2", "int2_3", "int2_4") # interest (post-test)
sco_ability_items <- c("SCO1", "SCO2", "SCO3", "SCO4", "SCO5_rev", "SCO6") # social comparison orientation ability
sco_opinion_items <- c("SCO7", "SCO8", "SCO9", "SCO10", "SCO11_rev") # social comparison orientation opinion
identification_items <- c("Ident1", "Ident2", "Ident3", "Ident4") # university identification
enjoyment_items <- c("End1", "End2_rev", "End3") # enjoyment of the task

# Diese Variablen können wir später zur Berechnung der Skalenmittelwerte nutzen

Skalenmittelwerte berechnen

# Wie beim letzten mal erstellen wir jetzt neue Spalten für die 
# Skalenmittelwerte mit der rowMeans()-Funktion
mydata[,"sc1_mean"] <- rowMeans(mydata[,sc1_items], na.rm = T)
mydata[,"sc2_mean"] <- rowMeans(mydata[,sc2_items], na.rm = T)
mydata[,"int1_mean"] <- rowMeans(mydata[,int1_items], na.rm = T)
mydata[,"int2_mean"] <- rowMeans(mydata[,int2_items], na.rm = T)
mydata[,"sco_ability_mean"] <- rowMeans(mydata[,sco_ability_items], na.rm = T)
mydata[,"sco_opinion_mean"] <- rowMeans(mydata[,sco_opinion_items], na.rm = T)
mydata[,"identification_mean"] <- rowMeans(mydata[,identification_items], na.rm = T)
mydata[,"enjoyment_mean"] <- rowMeans(mydata[,enjoyment_items], na.rm = T)

Datensatz aufräumen

# Zur besseren Übersicht bietet es sich nach Berechnung der Skalenmittelwerte 
# an einen neuen Datensatz zu erstellen, der die Einzelitems nicht beinhaltet 
mydata_scales <- select(mydata, !c(all_of(c(int1_items, int2_items, sc1_items, sc2_items, sco_ability_items, sco_opinion_items, enjoyment_items, identification_items)), "sc1_2", "sc1_4", "sc2_2", "sc2_4", "SCO5", "SCO11", "End2"))

Datensatz aufräumen

# Das geht auch mit der pipe
mydata_scales <- mydata |>
  select(!c(all_of(c(int1_items, int2_items, sc1_items, sc2_items, sco_ability_items, sco_opinion_items, enjoyment_items, identification_items)), "sc1_2", "sc1_4", "sc2_2", "sc2_4", "SCO5", "SCO11", "End2"))

# entspricht:
# select(mydata, !c(all_of(c(int1_items, int2_items, sc1_items, sc2_items, sco_ability_items, sco_opinion_items, enjoyment_items, identification_items)), "sc1_2", "sc1_4", "sc2_2", "sc2_4", "SCO5", "SCO11", "End2"))

# Die pipe nutzt die Variable vor der pipe |> als erstes Argument für die Funktion nach der pipe |>
# Teilweise wird auch %>% als pipe verwendet
# Für unsere heutigen Bedürfnisse sind beide pipes äquivalent
# %>% kommt aus der tidyverse-Bibliothek (bzw. aus magrittr), |> aus base R (keine Bibliothek nötig)

Daten aufbereiten

# Unsere Daten sind nicht ganz konsistent benannt
# Alter und Geschlecht sind groß geschrieben und auf Deutsch

# So können wir die Spalten neu benennen 
mydata_scales <- mydata_scales |>
  rename(age = Alter, gender = Geschlecht)

Die (einfache) lineare Regression

# Die summary()-Funktion liefert etwas ausführlichere Ergebnisse
summary(lm(sc2_mean ~ sc1_mean, data = mydata_scales))

Call:
lm(formula = sc2_mean ~ sc1_mean, data = mydata_scales)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.3794 -0.3616  0.0906  0.3107  1.9212 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  0.31849    0.18028   1.767   0.0792 .  
sc1_mean     0.88016    0.04113  21.400   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.6588 on 164 degrees of freedom
Multiple R-squared:  0.7363,    Adjusted R-squared:  0.7347 
F-statistic: 457.9 on 1 and 164 DF,  p-value: < 2.2e-16
# Interpretation:
# Intercept - Wenn alle Prädiktoren einen Wert von 0 haben (in diesem
# Fall also wenn sc1_mean 0 ist), erwarten wir einen Wert von 0.319
# für das Kriterium (sc2_mean). Jeder Anstieg um einen Punkt in sc1_mean, 
# bedeutet einen Anstieg des Erwartungswerts um 0.88 Punkt in sc2_mean.

Die (einfache) lineare Regression

# Grafisch sieht das dann so aus:
ggplot(mydata_scales, aes(x = sc1_mean, y = sc2_mean)) + 
  geom_point() +
  stat_smooth(method = "lm", col = "red") +
  xlim(0, 7) +
  ylim(0, 7)
# Die Grade repräsentiert das Intercept (Y-Achsen-Abschnitt) und die Steigung (Regressionsgewicht b bzw. Beta wenn wir alle Prädiktoren z-standardisieren)

Komplexere Gruppenvergleiche

Multiple Regression

# Fragestellung: Unterscheidet sich der Anstieg des Interesses von Pre-
# zu Post-Messung zwischen den Untersuchungsgruppen?
#
# Wie könnten wir vorgehen, um die Frage zu beantworten?

Multiple Regression

# Fragestellung: Unterscheidet sich der Anstieg des Interesses von Pre-
# zu Post-Messung zwischen den Untersuchungsgruppen?
#
# Wie könnten wir vorgehen, um die Frage zu beantworten?

Multiple Regression

# Zunächst bestimmen wir die Kontraste
contrasts(mydata_scales[,"sozpos"]) <- c(0,1)
# Weiß noch jemand was das für unser Modell bedeutet?

# Nullmodell zum Vergleich
model0 <- lm(int2_mean ~ 1, data = mydata_scales)

# So sagen wir anhand der Gruppe den Wert zum Posttest vorher:
model1 <- lm(int2_mean ~ sozpos, data = mydata_scales)

# So sagen wir anhand der Gruppe den anhand des Wertes zum Prä-Test
# korrigierten Wert zum Posttest vorher:
model2 <- lm(int2_mean ~ sozpos + int1_mean, data = mydata_scales)

# Und so schauen wir noch, ob sich die Untersuchungsbedingung abhängig von der Höhe des
# Prä-Test Werts unterschiedlich auf die Entwicklung von Prä- zum Post-Test auswirkt 
# bzw. ob der Zusammenhang zwischen Prä- und Post-Test je nach Untersuchungsbedingung unterschiedlich stark ist:
model3 <- lm(int2_mean ~ sozpos + int1_mean + sozpos:int1_mean, data = mydata_scales)
# Die Richtung der Interpretation ist eine inhaltliche Frage und kann zumindest in diesem Design nicht statistisch beantwortet werden.

# Disclaimer: Man kann so vorgehen, besser wäre aber bei ausreichender Stichprobengröße
# ein Mehrebenen-Modell! Dieses Beispiel ist nur zur Veranschaulichung.

Multiple Regression

summary(model0)

Call:
lm(formula = int2_mean ~ 1, data = mydata_scales)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2681 -1.0181  0.2319  1.2319  2.7319 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   4.2681     0.1237   34.51   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.593 on 165 degrees of freedom
# Interpretation?

Multiple Regression

summary(model0)

Call:
lm(formula = int2_mean ~ 1, data = mydata_scales)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2681 -1.0181  0.2319  1.2319  2.7319 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   4.2681     0.1237   34.51   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.593 on 165 degrees of freedom
# Interpretation: Der Mittelwert des Interesses (Post-Test) beträgt ca. 4.27.
mean(mydata_scales[,"int2_mean"])
[1] 4.268072

Multiple Regression

summary(model1)

Call:
lm(formula = int2_mean ~ sozpos, data = mydata_scales)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.3244 -0.9604  0.2326  1.2611  2.7896 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   4.2104     0.1764   23.87   <2e-16 ***
sozpos1       0.1140     0.2480    0.46    0.646    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.597 on 164 degrees of freedom
Multiple R-squared:  0.001288,  Adjusted R-squared:  -0.004802 
F-statistic: 0.2115 on 1 and 164 DF,  p-value: 0.6462
# Interpretation?

Multiple Regression

summary(model1)

Call:
lm(formula = int2_mean ~ sozpos, data = mydata_scales)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.3244 -0.9604  0.2326  1.2611  2.7896 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   4.2104     0.1764   23.87   <2e-16 ***
sozpos1       0.1140     0.2480    0.46    0.646    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.597 on 164 degrees of freedom
Multiple R-squared:  0.001288,  Adjusted R-squared:  -0.004802 
F-statistic: 0.2115 on 1 and 164 DF,  p-value: 0.6462
# Interpretation: Der Mittelwert des Interesses (Post-Test) in der low social position Gruppe (Referenzgruppe) beträgt ca. 4.21.
# Für die high social position Gruppe wird darauf ca. 0.11 aufaddiert.

Multiple Regression

# Das stimmt auch mathematisch mit den Mitelwerten der Gruppen überein:
mydata_scales |>
  group_by(sozpos) |>
  summarize(
    mean_int2 = mean(int2_mean)
  )
# A tibble: 2 × 2
  sozpos               mean_int2
  <fct>                    <dbl>
1 low social position       4.21
2 high social position      4.32

Multiple Regression

summary(model2)

Call:
lm(formula = int2_mean ~ sozpos + int1_mean, data = mydata_scales)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2994 -0.3308  0.1295  0.3846  3.3623 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) -0.11272    0.18038  -0.625   0.5329    
sozpos1      0.27868    0.10817   2.576   0.0109 *  
int1_mean    0.98745    0.03728  26.488   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.6956 on 163 degrees of freedom
Multiple R-squared:  0.8117,    Adjusted R-squared:  0.8094 
F-statistic: 351.4 on 2 and 163 DF,  p-value: < 2.2e-16
# Interpretation?

Multiple Regression

summary(model2)

Call:
lm(formula = int2_mean ~ sozpos + int1_mean, data = mydata_scales)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2994 -0.3308  0.1295  0.3846  3.3623 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) -0.11272    0.18038  -0.625   0.5329    
sozpos1      0.27868    0.10817   2.576   0.0109 *  
int1_mean    0.98745    0.03728  26.488   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.6956 on 163 degrees of freedom
Multiple R-squared:  0.8117,    Adjusted R-squared:  0.8094 
F-statistic: 351.4 on 2 and 163 DF,  p-value: < 2.2e-16
# Interpretation: Wenn in1_mean 0 ist, ist der Erwartungswert für das Interesse beim Post-Test in der low social position Gruppe (Referenzgruppe) ca. -0.11.
# Für jeden Punkt höher als 0 im Prä-Test Interesse werden darauf ca. 0.99 Punkt aufaddiert.
# Für Personen in der high social position Gruppe werden zusätzlich ca. 0.28 aufaddiert.

Multiple Regression

summary(model3)

Call:
lm(formula = int2_mean ~ sozpos + int1_mean + sozpos:int1_mean, 
    data = mydata_scales)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2435 -0.3227  0.1137  0.3528  3.4092 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)       -0.01935    0.23767  -0.081    0.935    
sozpos1            0.08451    0.33880   0.249    0.803    
int1_mean          0.96612    0.05136  18.810   <2e-16 ***
sozpos1:int1_mean  0.04526    0.07483   0.605    0.546    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.697 on 162 degrees of freedom
Multiple R-squared:  0.8121,    Adjusted R-squared:  0.8087 
F-statistic: 233.5 on 3 and 162 DF,  p-value: < 2.2e-16
# Interpretation?

Multiple Regression

summary(model3)

Call:
lm(formula = int2_mean ~ sozpos + int1_mean + sozpos:int1_mean, 
    data = mydata_scales)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2435 -0.3227  0.1137  0.3528  3.4092 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)       -0.01935    0.23767  -0.081    0.935    
sozpos1            0.08451    0.33880   0.249    0.803    
int1_mean          0.96612    0.05136  18.810   <2e-16 ***
sozpos1:int1_mean  0.04526    0.07483   0.605    0.546    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.697 on 162 degrees of freedom
Multiple R-squared:  0.8121,    Adjusted R-squared:  0.8087 
F-statistic: 233.5 on 3 and 162 DF,  p-value: < 2.2e-16
# Interpretation: Wenn in1_mean 0 ist, ist der Erwartungswert für das Interesse beim Post-Test in der low social position Gruppe (Referenzgruppe) ca. -0.02.
# Für jeden Punkt höher als 0 im Prä-Test Interesse werden darauf bei beiden Gruppen ca. 0.97 Punkt aufaddiert.
# Für Personen in der high social position Gruppe werden zusätzlich ca. 0.09 Punkte aufaddiert.
# Zusätzlich werden nur in der high social position Gruppe noch einmal für jeden Punkt höher als 0 im Prä-Test Interesse ca. 0.05 Punkte aufaddiert.

Multiple Regression

# Erklärt das jeweils komplexere Modell die Daten 
# wirklich besser als die jeweils einfacheren Modelle?
# Oder: Steigt das R-Quadrat signifikant an?
anova(model0, model1, model2, model3)
Analysis of Variance Table

Model 1: int2_mean ~ 1
Model 2: int2_mean ~ sozpos
Model 3: int2_mean ~ sozpos + int1_mean
Model 4: int2_mean ~ sozpos + int1_mean + sozpos:int1_mean
  Res.Df    RSS Df Sum of Sq        F Pr(>F)    
1    165 418.95                                 
2    164 418.41  1      0.54   1.1108 0.2935    
3    163  78.88  1    339.53 698.9043 <2e-16 ***
4    162  78.70  1      0.18   0.3659 0.5461    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# In diesem Fall würde es naheliegen sich für model2 zu entscheiden.

Übungsaufgabe

  • Führt die eben gezeigten Analysen mit dem Selbstkonzept durch und interpretiert die Ergebnisse

Lösung

  • Auf der nächsten Folie kommt die Lösung :)

Lösung

# Nullmodell:
model0sc <- lm(sc2_mean ~ 1, data = mydata_scales)

# Hier werden wieder die Post-Test Werte anhand der Gruppe
# vorhergesagt:
model1sc <- lm(sc2_mean ~ sozpos, data = mydata_scales)
# oder: model1sc <- update(model0sc, .~. + sozpos) 

# Hier wird wieder für die Prä-Test Werte korrigiert:
model2sc <- lm(sc2_mean ~ sozpos + sc1_mean, data = mydata_scales)
# oder: model2sc <- update(model1sc, .~. + sc1_mean)

# Und hier betrachten wir wieder, ob das ursprüngliche 
# Selbstkonzept den Effekt der Untersuchungsbedingung 
# beeinflusst:
model3sc <- lm(sc2_mean ~ sozpos + sc1_mean + sozpos:sc1_mean, data = mydata_scales)
# oder: model3sc <- update(model2sc, .~. + sc1_mean:sozpos)
# oder: model3sc <- lm(sc2_mean ~ sozpos*sc1_mean, data = mydata_scales)

Lösung - Modell 0

summary(model0sc)

Call:
lm(formula = sc2_mean ~ 1, data = mydata_scales)

Residuals:
     Min       1Q   Median       3Q      Max 
-3.01807 -0.76807 -0.01807  0.91943  2.98193 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  4.01807    0.09928   40.47   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.279 on 165 degrees of freedom
# Interpretation: Der Mittelwert im Selbstkonzept (Post-Test) beträgt ca. 4
# über beide Gruppen hinweg.

Lösung - Modell 1

summary(model1sc)

Call:
lm(formula = sc2_mean ~ sozpos, data = mydata_scales)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.3065 -0.8065  0.0274  0.9435  3.2774 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   3.7226     0.1379  26.991  < 2e-16 ***
sozpos1       0.5840     0.1939   3.012  0.00301 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.249 on 164 degrees of freedom
Multiple R-squared:  0.05242,   Adjusted R-squared:  0.04664 
F-statistic: 9.073 on 1 and 164 DF,  p-value: 0.003006

Lösung - Modell 2

summary(model2sc)

Call:
lm(formula = sc2_mean ~ sozpos + sc1_mean, data = mydata_scales)

Residuals:
     Min       1Q   Median       3Q      Max 
-3.13669 -0.30984 -0.00028  0.38017  2.12058 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  0.14221    0.17443   0.815    0.416    
sozpos1      0.44433    0.09673   4.593 8.69e-06 ***
sc1_mean     0.86861    0.03890  22.329  < 2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.6218 on 163 degrees of freedom
Multiple R-squared:  0.7665,    Adjusted R-squared:  0.7637 
F-statistic: 267.6 on 2 and 163 DF,  p-value: < 2.2e-16

Lösung - Modell 3

summary(model3sc)

Call:
lm(formula = sc2_mean ~ sozpos + sc1_mean + sozpos:sc1_mean, 
    data = mydata_scales)

Residuals:
     Min       1Q   Median       3Q      Max 
-3.09403 -0.27387 -0.00103  0.38017  2.06498 

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)       0.25022    0.23667   1.057    0.292    
sozpos1           0.22272    0.34157   0.652    0.515    
sc1_mean          0.84240    0.05494  15.333   <2e-16 ***
sozpos1:sc1_mean  0.05273    0.07793   0.677    0.500    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.6228 on 162 degrees of freedom
Multiple R-squared:  0.7672,    Adjusted R-squared:  0.7629 
F-statistic: 177.9 on 3 and 162 DF,  p-value: < 2.2e-16

Lösung - Modellvergleiche

anova(model0sc, model1sc, model2sc, model3sc)
Analysis of Variance Table

Model 1: sc2_mean ~ 1
Model 2: sc2_mean ~ sozpos
Model 3: sc2_mean ~ sozpos + sc1_mean
Model 4: sc2_mean ~ sozpos + sc1_mean + sozpos:sc1_mean
  Res.Df     RSS Df Sum of Sq        F    Pr(>F)    
1    165 269.946                                    
2    164 255.795  1    14.151  36.4777 1.022e-08 ***
3    163  63.024  1   192.771 496.9101 < 2.2e-16 ***
4    162  62.846  1     0.178   0.4578    0.4996    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Noch eine Übungsaufgabe

  • Dieses Mal nur mit metrischen Variablen
# installiert dafür die datarium-Bibliothek für den Datensatz
install.packages("datarium")
# und ladet den Datensatz
data("marketing", package = "datarium")
# Ihr solltet jetzt die Variable marketing im Arbeitsspeicher sehen

Noch eine Übungsaufgabe

# Zunächst inspizieren wir den Datensatz
describe(marketing)
          vars   n   mean     sd median trimmed    mad  min    max  range  skew
youtube      1 200 176.45 103.03 179.70  176.64 130.59 0.84 355.68 354.84 -0.07
facebook     2 200  27.92  17.82  27.48   27.60  23.75 0.00  59.52  59.52  0.09
newspaper    3 200  36.66  26.13  30.90   34.10  27.75 0.36 136.80 136.44  0.88
sales        4 200  16.83   6.26  15.48   16.54   5.78 1.92  32.40  30.48  0.40
          kurtosis   se
youtube      -1.24 7.28
facebook     -1.28 1.26
newspaper     0.57 1.85
sales        -0.45 0.44
# Sales ist unsere AV und zeigen die Verkaufszahlen 
# der jeweiligen Firma (Einheit unbekannt)
# Die anderen drei Variablen (YT, FB, NP) sind unsere UVs
# und zeigen die Werbungskosten (in 1000$) auf der 
# jeweiligen Plattform

Übungsaufgabe 1

Betrachtet die drei Plattformen zunächst einzeln und beantwortet die folgenden Fragestellungen:

  • Gibt es einen Zusammenhang zwischen den über Facebook/Youtube/Zeitungen ausgegebenen Werbegeldern und den Verkaufszahlen?

Lösung 1

  • Auf der nächsten Folie kommt die Lösung :)

Lösung 1-0

model0sales <- lm(sales ~ 1, data = marketing)
summary(model0sales)

Call:
lm(formula = sales ~ 1, data = marketing)

Residuals:
    Min      1Q  Median      3Q     Max 
-14.907  -4.377  -1.347   4.053  15.573 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  16.8270     0.4427   38.01   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 6.261 on 199 degrees of freedom
# Schauen wir uns zunächst das Intercept-only Modell an. 
# Der Mittelwert der sales in der Stichprobe beträgt 16.827
# und unterscheidet sich signifikant von 0.
mean(marketing$sales)
[1] 16.827

Lösung 1-1

modelFB <- lm(sales ~ facebook, data = marketing)
summary(modelFB)

Call:
lm(formula = sales ~ facebook, data = marketing)

Residuals:
     Min       1Q   Median       3Q      Max 
-18.8766  -2.5589   0.9248   3.3330   9.8173 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 11.17397    0.67548  16.542   <2e-16 ***
facebook     0.20250    0.02041   9.921   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 5.13 on 198 degrees of freedom
Multiple R-squared:  0.332, Adjusted R-squared:  0.3287 
F-statistic: 98.42 on 1 and 198 DF,  p-value: < 2.2e-16
# Interpretation: Eine Firma, die kein Geld auf Facebook ausgibt, 
# hat einen erwarteten Verkaufswert von ca. 11 Einheiten.
# Mit jedem Anstieg um 1000$ steigt auch der erwartete 
# Verkaufswert um ca. 0.2 Einheiten.
# Aber: Keine Kausalinterpretation zulässig (es sei denn es würde # sich um ein Experiment handeln).

Lösung 1-2

modelYT <- lm(sales ~ youtube, data = marketing)
summary(modelYT)

Call:
lm(formula = sales ~ youtube, data = marketing)

Residuals:
     Min       1Q   Median       3Q      Max 
-10.0632  -2.3454  -0.2295   2.4805   8.6548 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 8.439112   0.549412   15.36   <2e-16 ***
youtube     0.047537   0.002691   17.67   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 3.91 on 198 degrees of freedom
Multiple R-squared:  0.6119,    Adjusted R-squared:  0.6099 
F-statistic: 312.1 on 1 and 198 DF,  p-value: < 2.2e-16
# Interpretation: Eine Firma, die kein Geld auf Youtube ausgibt, 
# hat einen erwarteten Verkaufswert von ca. 8.4 Einheiten.
# Mit jedem Anstieg um 1000$ steigt auch der erwartete 
# Verkaufswert um ca. 0.05 Einheiten.

Lösung 1-3

modelNP <- lm(sales ~ newspaper, data = marketing)
summary(modelNP)

Call:
lm(formula = sales ~ newspaper, data = marketing)

Residuals:
    Min      1Q  Median      3Q     Max 
-13.473  -4.065  -1.007   4.207  15.330 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 14.82169    0.74570   19.88  < 2e-16 ***
newspaper    0.05469    0.01658    3.30  0.00115 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 6.111 on 198 degrees of freedom
Multiple R-squared:  0.05212,   Adjusted R-squared:  0.04733 
F-statistic: 10.89 on 1 and 198 DF,  p-value: 0.001148
# Interpretation: Eine Firma, die kein Geld bei Zeitungen ausgibt,
# hat einen erwarteten Verkaufswert von ca. 14.8 Einheiten.
# Mit jedem Anstieg um 1000$ steigt auch der erwartete 
# Verkaufswert um ca. 0.05 Einheiten.

Übungsaufgabe 2

  • Betrachtet nun die Werbekosten auf Facebook und Youtube gemeinsam

  • Beantwortet die Frage, ob die Daten für Synergie-Effekte sprechen (i.e., ob eine Investition auf FB und YT zusätzliche positive Effekte über die einzelnen Investitionen hinaus hat.)

  • Versucht dabei Schritt für Schritt vorzugehen. Fügt also pro Schritt nur einen Prädiktor hinzu und schaut wie sich das Ergebnis dabei verändert

Lösung 2

  • Auf der nächsten Folie kommt wieder die Lösung :)

Lösung 2-1

# Zunächst fügen wir den Prädiktor Werbungskosten Youtube zu unserem
# Facebook-Modell hinzu.
modelFBYT <- update(modelFB, .~. + youtube)
summary(modelFBYT)

Call:
lm(formula = sales ~ facebook + youtube, data = marketing)

Residuals:
     Min       1Q   Median       3Q      Max 
-10.5572  -1.0502   0.2906   1.4049   3.3994 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  3.50532    0.35339   9.919   <2e-16 ***
facebook     0.18799    0.00804  23.382   <2e-16 ***
youtube      0.04575    0.00139  32.909   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 2.018 on 197 degrees of freedom
Multiple R-squared:  0.8972,    Adjusted R-squared:  0.8962 
F-statistic: 859.6 on 2 and 197 DF,  p-value: < 2.2e-16
# Interpretation: Das Intercept zeigt hier, dass man bei Firmen, 
# die 0$ in Werbungskosten für FB und YT investieren, einen Verkaufswert
# von ca. 3.5 prognostizieren würde.
# Die Prädiktoren werden nur geringfügig kleiner.

Lösung 2-2

modelFBxYT <- update(modelFBYT, .~. + facebook:youtube)
summary(modelFBxYT)

Call:
lm(formula = sales ~ facebook + youtube + facebook:youtube, data = marketing)

Residuals:
    Min      1Q  Median      3Q     Max 
-7.6039 -0.4833  0.2197  0.7137  1.8295 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)      8.100e+00  2.974e-01  27.233   <2e-16 ***
facebook         2.886e-02  8.905e-03   3.241   0.0014 ** 
youtube          1.910e-02  1.504e-03  12.699   <2e-16 ***
facebook:youtube 9.054e-04  4.368e-05  20.727   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.132 on 196 degrees of freedom
Multiple R-squared:  0.9678,    Adjusted R-squared:  0.9673 
F-statistic:  1963 on 3 and 196 DF,  p-value: < 2.2e-16
# Interpretation: Das Intercept zeigt hier, dass man bei Firmen, 
# die 0$ in Werbungskosten für FB und YT investieren, einen Verkaufswert
# von ca. 8.1 prognostizieren würde.
# Jede 1000$ in Facebook Investitionen bringen dabei 0.029 + 0.0009 * 1000$-Youtube-Investitionen in sales. 
# Jede 1000$ in Youtube Investitionen bringen 0.019 + 0.0009 in 1000$-Facebook-Investition.
# Die Werbungskosten zeigen also Synergie-Effekte (i.e., Investitionen in Facebook 
# werden effektiver, je mehr man bei Youtube investiert).

Lösung 2-3

  • Das R² spricht für eine bessere Passung des Modells mit Interaktionsterm (ca. 97% aufgeklärte Varianz vs. ca. 90% aufgeklärte Varianz)
# Ein Modelltest zeigt, dass dieser Unterschied auch statistisch signifikant ist
anova(model0sales, modelFB, modelFBYT, modelFBxYT)
Analysis of Variance Table

Model 1: sales ~ 1
Model 2: sales ~ facebook
Model 3: sales ~ facebook + youtube
Model 4: sales ~ facebook + youtube + facebook:youtube
  Res.Df    RSS Df Sum of Sq       F    Pr(>F)    
1    199 7800.7                                   
2    198 5210.6  1    2590.1 2020.47 < 2.2e-16 ***
3    197  802.0  1    4408.7 3439.11 < 2.2e-16 ***
4    196  251.3  1     550.7  429.59 < 2.2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Das war’s!